000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.      HHCAL160.
000300*AUTHOR.          DDS TEAM.
000400*REVISED. 05/07/15 DDS TEAM.
000500*REMARKS.     (CENTERS FOR MEDICARE & MEDICAID SERVICES)
000600*REMARKS. A). NATIONAL HHA PRICER
000700***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2001
000800***       C). THERE ARE YEARLY HHA PRICER MODULES THAT WILL
000900***           CALCULATE THE HRG'S,REVENUE CODES AND
001000***           TYPE OF BILLS.
001100*REMARKS.
001200******************************************************************
001300*     FOR FY 2009 CALCULATIONS AND RATES NO CHANGES JUST SYNC TO
001400*              CORRECT LUPA RATE DETERMINATION IF LOGIC
001500*                CORRECT LUPA CALCULATION FOR REJECTED AND
001600*                REPROCESSED CLAIMS
001700*     HHCAL090   RATES EFFECTIVE JAN 1, 2009 CICS VERSION
001800*     HHCAL091   LUPA PAYMENT TO ZERO FOR ZERO REV VISITS
001900*     HHCAL092   HIPPA RECODE REVISION FOR 5 IN POS 1
002000*     HHCAL100 EXPAND BILLING RECORD TO 500 BYTES
002100*     HHCAL101
002200*     HHCAL106 CORRECT HIPPS RECODING ISSUE
002300*     HHCAL107 NEW HEALTH CARE REFORM
002400*     HHCAL111 CY 2011
002500*     HHCAL120 CY 2012
002600*     HHCAL131 CY 2013
002700*     HHCAL142 ADD NEW FIELDS FOR EARLIEST DATES ZERO
002800*              LUPA-ADD-ON-PAYMENT
002900*     HHCAL144 CORRECT THE EARLIEST DATE COMPARISON
003000*              ALSO CORRECT 3AGP VALUE IN HRGTABLE
003100*     HHCAL152 CY 2015
003110*     HHCAL160 CY 2016 - NO LOGIC CHANGES. VALUES ONLY.
003200*
003300******************************************************************
003400******************************************************************
003500*            RETURN CODE VALUES (HHA-RTC)
003600*
003700*        HHA-RTC  WITH PAYMENTS RETURNED
003800*
003900*     RETURN CODES
004000*          00 = FINAL PAYMENT
004100*               TOB = 329,339,327,337
004200*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
004300*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
004400*                  OR 32F OR 32K OR 32P OR 32H
004500*                  OR 33F OR 33K OR 33P OR 33H
004600*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES
004700*          01 = FINAL PAYMENT
004800*               TOB = 329,339,327,337
004900*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
005000*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
005100*                  OR 32F OR 32K OR 32P OR 32H
005200*                  OR 33F OR 33K OR 33P OR 33H
005300*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES
005400*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO
005500*               TOB = 332 AND 322
005600*          04 = INITIAL HALF PAYMENT PAID AT 50%
005700*               TOB = 332 AND 322
005800*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
005900*          05 = INITIAL HALF PAYMENT PAID AT 60%
006000*               TOB = 332 AND 322
006100*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
006200*       06,14 = LUPA PAYMENT ONLY
006300*               TOB = 329,339,327,337
006400*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
006500*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
006600*                  OR 32F OR 32K OR 32P OR 32H
006700*                  OR 33F OR 33K OR 33P OR 33H
006800*               WITH REVENUE CODES AND REVENUE QTYS < 5       *
006900******************************************************************
007000*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER
007100*               TOB = 329,339,327,337
007200*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
007300*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
007400*                  OR 32F OR 32K OR 32P OR 32H
007500*                  OR 33F OR 33K OR 33P OR 33H
007600*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
007700*               WITH MORE THAN ONE HRG OCCURRENCE             *
007800*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER
007900*               TOB = 329,339,327,337
008000*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
008100*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
008200*                  OR 32F OR 32K OR 32P OR 32H
008300*                  OR 33F OR 33K OR 33P OR 33H
008400*               WITH REVENUE CODE WHERE OUTLIER APPLIES
008500*               WITH MORE THAN ONE HRG OCCURRENCE             *
008600******************************************************************
008700*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER
008800*               TOB = 329,339,327,337
008900*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
009000*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
009100*                  OR 32F OR 32K OR 32P OR 32H
009200*                  OR 33F OR 33K OR 33P OR 33H
009300*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
009400*               WITH ONE HRG OCCURRENCE                       *
009500*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER
009600*               TOB = 329,339,327,337
009700*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
009800*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
009900*                  OR 32F OR 32K OR 32P OR 32H
010000*                  OR 33F OR 33K OR 33P OR 33H
010100*               WITH REVENUE CODE WHERE OUTLIER APPLIES
010200*               WITH ONE HRG OCCURRENCE                       *
010300******************************************************************
010400*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER
010500*               TOB = 329,339,327,337
010600*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
010700*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
010800*                  OR 32F OR 32K OR 32P OR 32H
010900*                  OR 33F OR 33K OR 33P OR 33H
011000*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
011100*               WITH MORE THAN ONE HRG OCCURRENCE             *
011200*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER
011300*               TOB = 329,339,327,337
011400*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
011500*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
011600*                  OR 32F OR 32K OR 32P OR 32H
011700*                  OR 33F OR 33K OR 33P OR 33H
011800*               WITH REVENUE CODE WHERE OUTLIER APPLIES
011900*               WITH MORE THAN ONE HRG OCCURRENCE             *
012000******************************************************************
012100******************************************************************
012200*                                                             *
012300*            HHA-RTC   NO PAYMENTS RETURNED                   *
012400*                                                             *
012500*              10 = INVALID TOB                               *
012600*                                                             *
012700*              15 = INVALID PEP DAYS                          *
012800*                   FOR SHORTENED EPISODE                     *
012900*                                                             *
013000*              16 = INVALID HRG DAYS , > 60 DAYS              *
013100*                                                             *
013200*              20 = INVALID PEP INDICATOR                     *
013300*                                                             *
013400*              25 = INVALID MED REVIEW INDICATOR              *
013500*                                                             *
013600*              30 = INVALID CBSA CODE                         *
013700*                                                             *
013800*              35 = INVALID INITIAL PAYMENT INDICATOR         *
013900*                        0 = MAKE NORMAL INITIAL PAYMENT      *
014000*                        1 = MAKE ZERO PAYMANT                *
014100*                                                             *
014200*              40 = INVALID SERVICE THRU DATE FOR             *
014300*                      CURRENT CALENDER YEAR                  *
014400*                                                             *
014500*              70 = INVALID OR NO HRG CODE PRESENT            *
014600*                                                             *
014700*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *
014800*                   REVENUE-QTY-COV-VISITS > 4  AND           *
014900*                       TOB = 329,339,327,337                 *
015000*                          OR 32G OR 33G OR 32I OR 33I        *
015100*                          OR 32J OR 33J OR 32M OR 33M        *
015200*                          OR 32F OR 32K OR 32P OR 32H
015300*                          OR 33F OR 33K OR 33P OR 33H
015400*                                                             *
015500*              80 = INVALID REVENUE CODE                      *
015600*                                                             *
015700*              85 = NO REVENUE CODE PRESENT                   *
015800*                   WITH TOB 329 OR 339 OR 327 OR 337         *
015900*                         OR 32G OR 33G OR 32I OR 33I         *
016000*                         OR 32J OR 33J OR 32M OR 33M         *
016100*                         OR 32F OR 32K OR 32P OR 32H
016200*                         OR 33F OR 33K OR 33P OR 33H
016300*                                                             *
016400***************************************************************
016500***************************************************************
016600***************************************************************
016700 DATE-COMPILED.
016800 ENVIRONMENT DIVISION.
016900 CONFIGURATION SECTION.
017000 SOURCE-COMPUTER.            IBM-370.
017100 OBJECT-COMPUTER.            IBM-370.
017200 INPUT-OUTPUT  SECTION.
017300 FILE-CONTROL.
017400
017500 DATA DIVISION.
017600 FILE SECTION.
017700
017800 WORKING-STORAGE SECTION.
017900 01  W-STORAGE-REF                  PIC X(46)  VALUE
018000     'HHCAL160       - W O R K I N G   S T O R A G E'.
018100 01  CAL-VERSION                    PIC X(07)  VALUE 'C2016.0'.
018200 01  CO1                            PIC S9(04) COMP SYNC.
018300 01  SUB1                           PIC S9(04) COMP SYNC.
018400 01  R1                             PIC S9(04) COMP SYNC.
018500 01  R2                             PIC S9(04) COMP SYNC.
018600 01  R3                             PIC S9(04) COMP SYNC.
018700
018800***************************************************************
018900*   YEARCHANGE - NO CHANGE FOR 2016                           *
018901*-------------------------------------------------------------*
018910* - DOES NOT CHANGE EACH YEAR                                 *
018920* - FROM CLAIM EXAMPLE SPREAD SHEET HIPPSPAYCALC TAB          *
019000***************************************************************
019100 01  LABOR-NLABOR-PERCENT.
019200     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.78535.
019300     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.21465.
019500***************************************************************
019600*   YEARCHANGE - NO CHANGE FOR 2016                           *
019700***************************************************************
019800 01  LUPA-ADD-ON                  PIC 9(03)V9(02) VALUE 093.96.
019900 01  LUPA-ADD-ON-RURAL            PIC 9(03)V9(02) VALUE 096.78.
020000 01  LUPA-ADD-ON-2PERCENT         PIC 9(03)V9(02) VALUE 095.85.
020100 01  LUPA-ADD-ON-2PERCENT-RUR     PIC 9(03)V9(02) VALUE 098.73.
020410***************************************************************
020420*   YEARCHANGE - NO CHANGE FOR 2016                           *
020430***************************************************************
020500 01  LUPA-ADD-ON-SN4              PIC 9(01)V9(04) VALUE 00.8451.
020600 01  LUPA-ADD-ON-PT1              PIC 9(01)V9(04) VALUE 00.6700.
020700 01  LUPA-ADD-ON-SLT3             PIC 9(01)V9(04) VALUE 00.6266.
020710*****************************************************************
020711*   YEARCHANGE - NO CHANGE FOR 2016                           *
020720***    EXAMPLE    ***********************************************
020730*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT *****
020740******  2327.68 TIMES 0.65  = 1512.99  ROUNDED UP  **************
020750*****************************************************************
020760 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.
020800
020810 01  LUPA-LABOR-ADJ               PIC 9(03)V9(02).
020820 01  LUPA-NON-LABOR-ADJ           PIC 9(03)V9(02).
020900 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.
021000 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.
021700
021800 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.
021900 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.
022000 01  WK-HRG-NO-OF-DAYS-FAC PIC S9(04)V9(06) VALUE 0.
022100 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.
022200 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.
022300 01  WK-ALL-TOTALS.
022400     05  FED-ADJ                        PIC S9(07)V9(02).
022500     05  FED-ADJP                       PIC S9(07)V9(02).
022600     05  FED-ADJ1                       PIC S9(07)V9(02).
022700     05  FED-ADJ2                       PIC S9(07)V9(02).
022800     05  FED-ADJ3                       PIC S9(07)V9(02).
022900     05  FED-ADJ4                       PIC S9(07)V9(02).
023000     05  FED-ADJ5                       PIC S9(07)V9(02).
023100     05  FED-ADJ6                       PIC S9(07)V9(02).
023200     05  FED-LUPA-ADJ1                  PIC S9(07)V9(02).
023300     05  FED-LUPA-ADJ2                  PIC S9(07)V9(02).
023400     05  FED-LUPA-ADJ3                  PIC S9(07)V9(02).
023500     05  FED-LUPA-ADJ4                  PIC S9(07)V9(02).
023600     05  FED-LUPA-ADJ5                  PIC S9(07)V9(02).
023700     05  FED-LUPA-ADJ6                  PIC S9(07)V9(02).
023800     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).
023900     05  FED-LABOR-ADJP                 PIC S9(07)V9(02).
024000     05  FED-LABOR-ADJ1                 PIC S9(07)V9(02).
024100     05  FED-LABOR-ADJ2                 PIC S9(07)V9(02).
024200     05  FED-LABOR-ADJ3                 PIC S9(07)V9(02).
024300     05  FED-LABOR-ADJ4                 PIC S9(07)V9(02).
024400     05  FED-LABOR-ADJ5                 PIC S9(07)V9(02).
024500     05  FED-LABOR-ADJ6                 PIC S9(07)V9(02).
024600     05  FED-LABOR-LUPA-ADJ1            PIC S9(07)V9(02).
024700     05  FED-LABOR-LUPA-ADJ2            PIC S9(07)V9(02).
024800     05  FED-LABOR-LUPA-ADJ3            PIC S9(07)V9(02).
024900     05  FED-LABOR-LUPA-ADJ4            PIC S9(07)V9(02).
025000     05  FED-LABOR-LUPA-ADJ5            PIC S9(07)V9(02).
025100     05  FED-LABOR-LUPA-ADJ6            PIC S9(07)V9(02).
025200     05  FED-SUPPLY-ADJ                 PIC S9(07)V9(02).
025300     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).
025400     05  FED-NON-LABOR-ADJP             PIC S9(07)V9(02).
025500     05  FED-NON-LABOR-ADJ1             PIC S9(07)V9(02).
025600     05  FED-NON-LABOR-ADJ2             PIC S9(07)V9(02).
025700     05  FED-NON-LABOR-ADJ3             PIC S9(07)V9(02).
025800     05  FED-NON-LABOR-ADJ4             PIC S9(07)V9(02).
025900     05  FED-NON-LABOR-ADJ5             PIC S9(07)V9(02).
026000     05  FED-NON-LABOR-ADJ6             PIC S9(07)V9(02).
026100     05  FED-NON-LABOR-LUPA-ADJ1        PIC S9(07)V9(02).
026200     05  FED-NON-LABOR-LUPA-ADJ2        PIC S9(07)V9(02).
026300     05  FED-NON-LABOR-LUPA-ADJ3        PIC S9(07)V9(02).
026400     05  FED-NON-LABOR-LUPA-ADJ4        PIC S9(07)V9(02).
026500     05  FED-NON-LABOR-LUPA-ADJ5        PIC S9(07)V9(02).
026600     05  FED-NON-LABOR-LUPA-ADJ6        PIC S9(07)V9(02).
026700     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).
026800     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).
026900     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).
027000     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).
027100     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).
027200     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).
027300     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).
027400     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).
027500     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).
027600     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).
027700     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).
027800     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).
027900     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).
028000     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).
028100     05  WK-7000-CALC                   PIC S9(07)V9(02).
028200     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).
028300     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).
028400     05  WK-10000-OUTLIER-POOL-DIF      PIC S9(07)V9(02).
028500     05  WK-10000-OUTLIER-POOL-PERCENT  PIC S9(09)V9(02).
028600     05  WK-10000-OUTLIER-AVAIL-POOL    PIC S9(09)V9(02).
028700
028800 01  WORK-HRG.
028900     05  WORK-HRG1                      PIC X(01).
029000     05  WORK-HRG2                      PIC X(01).
029100     05  WORK-HRG3                      PIC X(01).
029200     05  WORK-HRG4                      PIC X(01).
029300     05  WORK-HRG5                      PIC X(01).
029400
029500
029600*******************************************************
029700 01  HOLD-HHA-DATA.
029800     05  H-HHA-INPUT-DATA.
029900         10  H-HHA-NPI                 PIC X(10).
030000         10  H-HHA-HIC                 PIC X(12).
030100         10  H-HHA-PROV-NO             PIC X(06).
030200         10  H-HHA-TOB                 PIC XXX.
030300             88 H-VALID-TOB-CLAIM       VALUE
030400             '329', '339', '327', '337',
030500             '32G', '33G', '32I', '33I',
030600             '32J', '33J', '32M', '33M', '32Q',
030700             '32F', '32K', '32P', '32H', '33Q',
030800             '33F', '33K', '33P', '33H'.
030900             88 H-VALID-TOB-RAP         VALUE
031000             '322', '332'.
031100*                                                             *
031200         10  H-HHA-PEP-INDICATOR       PIC X.
031300         10  H-HHA-PEP-DAYS            PIC 999.
031400         10  H-HHA-INIT-PAY-INDICATOR  PIC X.
031500             88 H-HHA-WITH-DATA-CHECK VALUE '0', '1'.
031600             88 H-HHA-NO-DATA-CHECK   VALUE '2', '3'.
031700         10  FILLER                    PIC X(07).
031800         10  H-HHA-MSA1                PIC 9(07)V9(02).
031900         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.
032000             15  FILLER             PIC XXX.
032100             15  H-HHA-MSA2         PIC XXXX.
032200             15  FILLER             PIC XX.
032300         10  H-HHA-CBSA-DATA REDEFINES H-HHA-MSA1.
032400             15  FILLER             PIC XX.
032500             15  H-HHA-CBSA         PIC XXXXX.
032600             15  FILLER             PIC XX.
032700         10  H-HHA-SERV-FROM-DATE.
032800             15  H-HHA-FROM-CC         PIC XX.
032900             15  H-HHA-FROM-YYMMDD.
033000                 25  H-HHA-FROM-YY     PIC XX.
033100                 25  H-HHA-FROM-MM     PIC XX.
033200                 25  H-HHA-FROM-DD     PIC XX.
033300         10  H-HHA-SERV-THRU-DATE.
033400             15  H-HHA-THRU-CC         PIC XX.
033500             15  H-HHA-THRU-YYMMDD.
033600                 25  H-HHA-THRU-YY     PIC XX.
033700                 25  H-HHA-THRU-MM     PIC XX.
033800                 25  H-HHA-THRU-DD     PIC XX.
033900         10  H-HHA-ADMIT-DATE.
034000             15  H-HHA-ADMIT-CC        PIC XX.
034100             15  H-HHA-ADMIT-YYMMDD.
034200                 25  H-HHA-ADMIT-YY    PIC XX.
034300                 25  H-HHA-ADMIT-MM    PIC XX.
034400                 25  H-HHA-ADMIT-DD    PIC XX.
034500         10  H-HHA-HRG-DATA      OCCURS 6.
034600             15  H-HHA-MED-REVIEW-INDICATOR PIC X.
034700             15  H-HHA-HRG-INPUT-CODE       PIC X(05).
034800             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).
034900             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).
035000             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).
035100             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).
035200         10  H-HHA-REVENUE-DATA     OCCURS 6.
035300             15  H-HHA-REVENUE-CODE             PIC X(04).
035400             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).
035500             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).
035600             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).
035700             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).
035800             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).
035900     05  H-HHA-PASSBACK-DATA.
036000         10  H-HHA-PAY-RTC                PIC 99.
036100         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).
036200         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).
036300         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).
036400         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).
036500     05  H-HHA-CASE-MIX-DATA.
036600         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).
036700         10  H-HHA-LUPA-SRC-ADM           PIC X.
036800         10  H-HHA-RECODE-IND             PIC X.
036900         10  H-HHA-EPISODE-TIMING         PIC 9.
037000         10  H-HHA-SEVERITY-POINTS.
037100             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).
037200             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).
037300             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).
037400             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).
037500             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).
037600             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).
037700             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).
037800             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).
037900     05  H-HHA-PROV-TOTAL-DATA.
038000         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).
038100         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).
038200     05  FILLER                           PIC X(33).
038300**==================================================***
038400*    05  FILLER                         PIC X(20).
038500**==================================================***
038600
038700 LINKAGE SECTION.
038800***************************************************************
038900*                 * * * * * * * * *                           *
039000***************************************************************
039100***************************************************************
039200*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *
039300*    AND PASSED BACK TO THE CALLING PROGRAM                   *
039400***************************************************************
039500 01  HHA-INPUT-DATA.
039600     05  HHA-DATA.
039700         10  HHA-NPI                 PIC X(10).
039800         10  HHA-HIC                 PIC X(12).
039900         10  HHA-PROV-NO             PIC X(06).
040000         10  HHA-TOB                 PIC XXX.
040001             88 HHA-VALID-TOB-CLAIM       VALUE
040002             '329', '339', '327', '337',
040003             '32G', '33G', '32I', '33I',
040004             '32J', '33J', '32M', '33M', '32Q',
040005             '32F', '32K', '32P', '32H', '33Q',
040006             '33F', '33K', '33P', '33H'.
040007             88 HHA-VALID-TOB-RAP         VALUE
040008             '322', '332'.
040009*                                                             *
040100         10  HHA-PEP-INDICATOR       PIC X.
040200         10  HHA-PEP-DAYS            PIC 999.
040300         10  HHA-INIT-PAY-INDICATOR  PIC X.
040400             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.
040500             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.
040600         10  FILLER                  PIC X(07).
040700         10  HHA-MSA1                PIC 9(07)V9(02).
040800         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.
040900             15  FILLER             PIC XXX.
041000             15  HHA-MSA2.
041100                 25  HHA-MSA2-RURAL-1ST.
041200                     30  HHA-RURAL-MSA         PIC XX.
041300                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.
041400                 25  HHA-MSA2-RURAL-2ND        PIC XX.
041500             15  FILLER             PIC XX.
041600         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.
041700             15  FILLER             PIC XX.
041800             15  HHA-CBSA.
041900                 88  HHA-CBSA-RURAL-CHECK-ALL VALUE
042000                 '50001', '50002', '50005', '50007', '50025',
042100                 '50028', '50031', '50035', '50036', '50037',
042200                 '50041', '50045', '50047', '50048', '50050',
042300                 '50056', '50057', '50066', '50068', '50071',
042400                 '50073', '50080', '50084', '50087', '50089',
042500                 '50090', '50091', '50103', '50104', '50111',
042600                 '50115', '50117', '50118', '50120', '50121',
042700                 '50139', '50146', '50147', '50149', '50151',
042800                 '50164', '50165', '50168', '50169', '50173',
042900                 '50174', '50177', '50180', '50182', '50183'.
043000*
043100                 25  HHA-CBSA-RURAL-1ST.
043200                     30  HHA-RURAL-CBSA        PIC XXX.
043300                     88  HHA-CBSA-RURAL-CHECK   VALUE '999'.
043400                 25  HHA-CBSA-RURAL-2ND        PIC XX.
043500             15  FILLER             PIC XX.
043600         10  HHA-SERV-FROM-DATE.
043700             15  HHA-FROM-CC         PIC XX.
043800             15  HHA-FROM-YYMMDD.
043900                 25  HHA-FROM-YY     PIC XX.
044000                 25  HHA-FROM-MM     PIC XX.
044100                 25  HHA-FROM-DD     PIC XX.
044200         10  HHA-SERV-THRU-DATE.
044300             15  HHA-THRU-CC         PIC XX.
044400             15  HHA-THRU-YYMMDD.
044500                 25  HHA-THRU-YY     PIC XX.
044600                 25  HHA-THRU-MM     PIC XX.
044700                 25  HHA-THRU-DD     PIC XX.
044800         10  HHA-ADMIT-DATE.
044900             15  HHA-ADMIT-CC        PIC XX.
045000             15  HHA-ADMIT-YYMMDD.
045100                 25  HHA-ADMIT-YY    PIC XX.
045200                 25  HHA-ADMIT-MM    PIC XX.
045300                 25  HHA-ADMIT-DD    PIC XX.
045400         10  HHA-HRG-DATA      OCCURS 6.
045500             15  HHA-MED-REVIEW-INDICATOR PIC X.
045600             15  HHA-HRG-INPUT-CODE       PIC X(05).
045700             15  HHA-HRG-OUTPUT-CODE      PIC X(05).
045800             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).
045900             15  HHA-HRG-WGTS             PIC 9(02)V9(04).
046000             15  HHA-HRG-PAY              PIC 9(07)V9(02).
046100         10  HHA-REVENUE-DATA     OCCURS 6.
046200             15  HHA-REVENUE-CODE             PIC X(04).
046300             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).
046400             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).
046500             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).
046600             15  HHA-REVENUE-COST             PIC 9(07)V9(02).
046700             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).
046800     05  HHA-PASSBACK-DATA.
046900         10  HHA-PAY-RTC                PIC 99.
047000         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).
047100         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).
047200         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).
047300         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).
047400     05  HHA-CASE-MIX-DATA.
047500         10  HHA-LUPA-ADD-ON-PAYMENT      PIC 9(03)V9(02).
047600         10  HHA-LUPA-SRC-ADM             PIC X.
047700         10  HHA-RECODE-IND               PIC X.
047800         10  HHA-EPISODE-TIMING           PIC 9.
047900         10  HHA-SEVERITY-POINTS.
048000             15  HHA-CLINICAL-SEV-EQ1     PIC X(01).
048100             15  HHA-FUNCTION-SEV-EQ1     PIC X(01).
048200             15  HHA-CLINICAL-SEV-EQ2     PIC X(01).
048300             15  HHA-FUNCTION-SEV-EQ2     PIC X(01).
048400             15  HHA-CLINICAL-SEV-EQ3     PIC X(01).
048500             15  HHA-FUNCTION-SEV-EQ3     PIC X(01).
048600             15  HHA-CLINICAL-SEV-EQ4     PIC X(01).
048700             15  HHA-FUNCTION-SEV-EQ4     PIC X(01).
048800     05  HHA-PROV-TOTAL-DATA.
048900         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).
049000         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).
049100     05  FILLER                         PIC X(33).
049200**==================================================***
049300*    05  FILLER                         PIC X(20).
049400
049500 01  HOLD-VARIABLES-DATA.
049600     02  HOLD-VAR-DATA.
049700         05  PRICER-OPTION-SW                   PIC X(01).
049800         05  HHOPN-VERSION                      PIC X(07).
049900         05  HHDRV-VERSION                      PIC X(07).
050000         05  HHCAL-VERSION                      PIC X(07).
050100         05  FILLER                             PIC X(20).
050200
050300 01  CBSA-WAGE-INDEX-DATA.
050400     02  HOLD-WIR-DATA.
050500         05  WIR-CBSA                       PIC X(05).
050600         05  WIR-CBSA-EFFDATE               PIC X(08).
050700         05  WIR-CBSA-WAGEIND               PIC 9(02)V9(04).
050800
050900 PROCEDURE DIVISION  USING HHA-INPUT-DATA
051000                           HOLD-VARIABLES-DATA
051100                           CBSA-WAGE-INDEX-DATA.
051200
051300***************************************************************
051400*    PROCESSING:                                              *
051500*        A. WILL PROCESS NATIONAL HHA FOR CY 2010             *
051600*                STARTING JAN 1, 2010                         *
051700***************************************************************
051800
051900     MOVE CAL-VERSION TO HHCAL-VERSION.
052000
052100     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.
052200
052300*         YEARCHANGE  2014.1                      ===========**
052400     MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
052500*         YEARCHANGE  2014.1                      ===========**
052600
052700     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.
052800
052900     GOBACK.
053000
053100 200-MAINLINE-CONTROL.
053200
053300     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.
053400
053500
053600*     DISPLAY '-- HHA-HIC HHCAL152  ===> ' HHA-HIC.
053700
053800     MOVE ALL '0' TO
053900                     WK-ALL-TOTALS
054000                     WK-HRG-NO-OF-DAYS
054100                     WK-HRG-NO-OF-DAYS-TOT
054200                     WK-RTC-ADJ-IND
054300                     WK-PEP-DAYS
054400                     H-HHA-PASSBACK-DATA
054500                     H-HHA-HRG-PAY (1)
054600                     H-HHA-HRG-PAY (2)
054700                     H-HHA-HRG-PAY (3)
054800                     H-HHA-HRG-PAY (4)
054900                     H-HHA-HRG-PAY (5)
055000                     H-HHA-HRG-PAY (6)
055100                     H-HHA-REVENUE-COST (1)
055200                     H-HHA-REVENUE-COST (2)
055300                     H-HHA-REVENUE-COST (3)
055400                     H-HHA-REVENUE-COST (4)
055500                     H-HHA-REVENUE-COST (5)
055600                     H-HHA-REVENUE-COST (6)
055700                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
055800                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
055900                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
056000                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
056100                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (5)
056200                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (6).
056300
056400     IF  H-HHA-PAY-RTC = 00
056500         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.
056600
056700 200-EXIT.   EXIT.
056800
056900 400-CALC-THE-HHA.
057000
057100*    IF H-HHA-SERV-THRU-DATE < 20070101
057200*        MOVE '40' TO H-HHA-PAY-RTC
057300*        GO TO 400-EXIT.
057400
057500     IF H-HHA-ADMIT-DATE >
057600        H-HHA-SERV-FROM-DATE
057700         MOVE '40' TO H-HHA-PAY-RTC
057800         GO TO 400-EXIT.
057900
058000     IF (H-VALID-TOB-RAP  AND
058100        (H-HHA-HRG-INPUT-CODE (1) = SPACE))
058200        MOVE '70' TO H-HHA-PAY-RTC
058300        GO TO 400-EXIT.
058400
058500     IF (H-VALID-TOB-CLAIM AND
059000         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND
059100         (H-HHA-HRG-INPUT-CODE (1) = SPACE))
059200        MOVE '75' TO H-HHA-PAY-RTC
059300        GO TO 400-EXIT.
059400
059500     IF (H-VALID-TOB-CLAIM AND
060000         (H-HHA-REVENUE-CODE (1) = SPACE))
060100        MOVE '85' TO H-HHA-PAY-RTC
060200        GO TO 400-EXIT.
060300
060400     IF (H-VALID-TOB-CLAIM AND
060900         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND
061000         (H-HHA-PEP-INDICATOR = 'Y') AND
061100         (H-HHA-PEP-DAYS NOT NUMERIC OR
061200          H-HHA-PEP-DAYS = ZEROES))
061300        MOVE '15' TO H-HHA-PAY-RTC
061400        GO TO 400-EXIT.
061500
061600     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.
061700
061800***************************************************************
061900***************************************************************
062000*        THESE RATES & THRESHOLDS ARE APPLIED                 *
062100* FOR NON-RURAL AND  RURAL                                    *
062200***************************************************************
062210*   YEARCHANGE - CHANGED FOR 2016                             *
062400***************************************************************
062500* FOR NON RURAL NO DATA - TABLE 2
062600     MOVE 02906.92 TO   FED-EPISODE-RATE-AMT.
062700     MOVE 01308.11 TO   OUTLIER-THRESHOLD-AMT.
062800
062900*-------------------------------------------------------------*
062910*   YEARCHANGE - CHANGED FOR 2016                             *
063000*   WITH REPORTING DATA                                       *
063110*-------------------------------------------------------------*
063300     IF HHA-WITH-DATA-CHECK
063400        NEXT SENTENCE
063500     ELSE
063600        GO TO NO-REPORTING-DATA.
063700
063800        IF HHA-CBSA-RURAL-CHECK
063900        OR HHA-CBSA-RURAL-CHECK-ALL
063910*-------------------------------------------------------------*
064001*   YEARCHANGE - CHANGED FOR 2016                             *
064100*   RURAL, AND REPORTING DATA --  TABLE 8, 1ST GROUP, 2ND COL *
064200*-------------------------------------------------------------*
064400           MOVE 03054.07 TO   FED-EPISODE-RATE-AMT
064500           MOVE 01374.33 TO   OUTLIER-THRESHOLD-AMT
064600        ELSE
064610*-------------------------------------------------------------*
064710*   YEARCHANGE - CHANGED FOR 2016                             *
064800*   NON RURAL, AND REPORTING DATA -- TABLE 1                  *
064910*-------------------------------------------------------------*
065100           MOVE 02965.12 TO   FED-EPISODE-RATE-AMT
065200           MOVE 01334.30 TO   OUTLIER-THRESHOLD-AMT.
065300
065400
065500      GO TO PROCESS-PAYMENT.
065600
065700 NO-REPORTING-DATA.
065800
065900        IF HHA-CBSA-RURAL-CHECK
066000        OR HHA-CBSA-RURAL-CHECK-ALL
066010*-------------------------------------------------------------*
066020*   YEARCHANGE - CHANGED FOR 2016                             *
066200*   RURAL, AND NO REPORTING DATA - TABLE 8, 2ND GROUP, 2ND COL*
066300*-------------------------------------------------------------*
066500           MOVE 02994.13 TO   FED-EPISODE-RATE-AMT
066600           MOVE 01347.36 TO   OUTLIER-THRESHOLD-AMT
066700        GO TO PROCESS-PAYMENT.
066800
066900
067000*------------------------------------------------------
067100
067200
067300 PROCESS-PAYMENT.
067400
067500*------------------------------------------------------
067600***************************************************************
067700
067800     IF H-VALID-TOB-RAP
067900        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT
068000        GO TO 400-EXIT.
068100
068200     IF H-VALID-TOB-CLAIM
068700        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT
068800        GO TO 400-EXIT.
068900
069000     MOVE '10' TO H-HHA-PAY-RTC.
069100
069200
069300 400-EXIT.   EXIT.
069400
069500 500-INITIAL-PAYMENT.
069600
069700***************************************************************
069800*            TOB = 322 OR 332 INITIAL PAYMENT
069900***************************************************************
070000
070100     IF  H-HHA-INIT-PAY-INDICATOR  = '0' OR '1' OR '2' OR '3'
070200         NEXT SENTENCE
070300     ELSE
070400         MOVE '35' TO H-HHA-PAY-RTC
070500         GO TO 500-EXIT.
070600
070700     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '3'
070800         MOVE '03' TO H-HHA-PAY-RTC
070900         GO TO 500-EXIT.
071000
071100     COMPUTE FED-ADJ ROUNDED =
071200               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
071300
071400     COMPUTE FED-LABOR-ADJ ROUNDED =
071500             WIR-CBSA-WAGEIND *
071600             LABOR-PERCENT *
071700             FED-ADJ.
071800
071900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
072000              (NONLABOR-PERCENT * FED-ADJ).
072100
072200     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
072300
072400*         YEARCHANGE                              ===========**
072500
072600      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
072700
072800*         YEARCHANGE                              ===========**
072900
073000*    IF HHA-SERV-THRU-DATE > 20071231 AND
073100*       HHA-SERV-FROM-DATE > 20071231
073200*        NEXT SENTENCE
073300*    ELSE
073400*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
073500
073600
073700     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE
073800        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
073900       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .6
074000        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)
074100        MOVE '05' TO H-HHA-PAY-RTC
074200     ELSE
074300        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
074400       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .5
074500        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)
074600        MOVE '04' TO H-HHA-PAY-RTC.
074700
074800 500-EXIT.   EXIT.
074900
075000 1000-FINAL-PAYMENT.
075100
075200     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC
075300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).
075400     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC
075500        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).
075600     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC
075700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).
075800     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC
075900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).
076000     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC
076100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).
076200     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC
076300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).
076400
076500     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =
076600             H-HHA-REVENUE-QTY-COV-VISITS (1) +
076700             H-HHA-REVENUE-QTY-COV-VISITS (2) +
076800             H-HHA-REVENUE-QTY-COV-VISITS (3).
076900     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =
077000             H-HHA-REVENUE-QTY-COV-VISITS (1) +
077100             H-HHA-REVENUE-QTY-COV-VISITS (2) +
077200             H-HHA-REVENUE-QTY-COV-VISITS (3) +
077300             H-HHA-REVENUE-QTY-COV-VISITS (4) +
077400             H-HHA-REVENUE-QTY-COV-VISITS (5) +
077500             H-HHA-REVENUE-QTY-COV-VISITS (6).
077600
077700     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
077800
077900     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5
078000       NEXT SENTENCE
078100     ELSE
078200       GO TO PEP-CHECK.
078300
078400*01  LUPA-ADD-ON
078500*01  LUPA-ADD-ON-RURAL
078600*01  LUPA-ADD-ON-2PERCENT
078700*01  LUPA-ADD-ON-2PERCENT-RUR
078800
078900     IF HHA-WITH-DATA-CHECK
079000        IF HHA-CBSA-RURAL-CHECK
079100        OR HHA-CBSA-RURAL-CHECK-ALL
079200         COMPUTE LUPA-LABOR-ADJ ROUNDED =
079300                 WIR-CBSA-WAGEIND *
079400                 LABOR-PERCENT *
079500                 LUPA-ADD-ON-2PERCENT-RUR
079600        ELSE
079700         COMPUTE LUPA-LABOR-ADJ ROUNDED =
079800                 WIR-CBSA-WAGEIND *
079900                 LABOR-PERCENT *
080000                 LUPA-ADD-ON-2PERCENT
080100        END-IF
080200     ELSE
080300        IF HHA-CBSA-RURAL-CHECK
080400        OR HHA-CBSA-RURAL-CHECK-ALL
080500         COMPUTE LUPA-LABOR-ADJ ROUNDED =
080600                 WIR-CBSA-WAGEIND *
080700                 LABOR-PERCENT *
080800                 LUPA-ADD-ON-RURAL
080900        ELSE
081000         COMPUTE LUPA-LABOR-ADJ ROUNDED =
081100                 WIR-CBSA-WAGEIND *
081200                 LABOR-PERCENT *
081300                 LUPA-ADD-ON
081400        END-IF
081500     END-IF.
081600
081700     IF HHA-WITH-DATA-CHECK
081800        IF HHA-CBSA-RURAL-CHECK
081900        OR HHA-CBSA-RURAL-CHECK-ALL
082000         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
082100                 NONLABOR-PERCENT *
082200                 LUPA-ADD-ON-2PERCENT-RUR
082300        ELSE
082400         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
082500                 NONLABOR-PERCENT *
082600                  LUPA-ADD-ON-2PERCENT
082700        END-IF
082800     ELSE
082900        IF HHA-CBSA-RURAL-CHECK
083000        OR HHA-CBSA-RURAL-CHECK-ALL
083100         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
083200                 NONLABOR-PERCENT *
083300                 LUPA-ADD-ON-RURAL
083400        ELSE
083500         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
083600                 NONLABOR-PERCENT *
083700                 LUPA-ADD-ON
083800        END-IF
083900     END-IF.
084000
084100
084200*    IF H-HHA-ADMIT-DATE = H-HHA-SERV-FROM-DATE AND
084300*        WORK-HRG1 = '1' OR '2'
084400*       COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
084500*         LUPA-LABOR-ADJ + LUPA-NON-LABOR-ADJ
084600*    ELSE
084700*       MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
084800*
084900***         VARYING SUB1 FROM 1 BY 1 UNTIL
085000***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR
085100***          SUB1 > 6.
085200
085300
085400**   CHANGE MISSING DATES TO DEFAULT FOR EARLIEST DATE COMPARE **
085500
085600     IF H-HHA-REVENUE-EARLIEST-DATE (1) = 0
085700        MOVE 29990101 TO H-HHA-REVENUE-EARLIEST-DATE (1).
085800
085900     IF H-HHA-REVENUE-EARLIEST-DATE (3) = 0
086000        MOVE 29990101 TO H-HHA-REVENUE-EARLIEST-DATE (3).
086100
086200     IF H-HHA-REVENUE-EARLIEST-DATE (4) = 0
086300        MOVE 29990101 TO H-HHA-REVENUE-EARLIEST-DATE (4).
086400
086500*    IF REVENUE EARLIEST DATES = ALL 9'S THEN
086600*    LUPA ADD ON DOES NOT CALCULATE
086700
086800     IF (H-HHA-REVENUE-EARLIEST-DATE (1) = 99999999 AND
086900         H-HHA-REVENUE-EARLIEST-DATE (3) = 99999999 AND
087000         H-HHA-REVENUE-EARLIEST-DATE (4) = 99999999)
087100         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
087200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
087300                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
087400                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
087500                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
087600                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5)
087700         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
087800           GO TO RTC-CHECK.
087900
088000*    IF  REVENUE EARLIEST DATES = DEFAULT THEN
088100*    LUPA ADD ON DOES NOT CALCULATE
088200
088300     IF (H-HHA-REVENUE-EARLIEST-DATE (1) = 29990101 AND
088400         H-HHA-REVENUE-EARLIEST-DATE (3) = 29990101 AND
088500         H-HHA-REVENUE-EARLIEST-DATE (4) = 29990101)
088600         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
088700                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
088800                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
088900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
089000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
089100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5)
089200         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
089300           GO TO RTC-CHECK.
089400
089500*    IF PT OCCURS ON EARLIEST DATE THEN LUPA ADD ON APPLIES TO
089600*       PT
089700
089800     IF (H-HHA-REVENUE-EARLIEST-DATE (1) <
089900         H-HHA-REVENUE-EARLIEST-DATE (3)) AND
090000        (H-HHA-REVENUE-EARLIEST-DATE (1) <
090100         H-HHA-REVENUE-EARLIEST-DATE (4))
090200        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) ROUNDED =
090300           H-HHA-REVENUE-DOLL-RATE (1) * LUPA-ADD-ON-PT1
090400        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
090500           H-HHA-LUPA-ADD-ON-PAYMENT +
090600           H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
090700           GO TO RTC-CHECK.
090800
090900*    IF SLT OCCURS ON EARLIEST DATE THEN LUPA ADD ON APPLIES TO
091000*       SLT
091100
091200     IF (H-HHA-REVENUE-EARLIEST-DATE (3) <
091300         H-HHA-REVENUE-EARLIEST-DATE (1)) AND
091400        (H-HHA-REVENUE-EARLIEST-DATE (3) <
091500         H-HHA-REVENUE-EARLIEST-DATE (4))
091600        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (3) ROUNDED =
091700           H-HHA-REVENUE-DOLL-RATE (3) * LUPA-ADD-ON-SLT3
091800        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
091900           H-HHA-LUPA-ADD-ON-PAYMENT +
092000           H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
092100           GO TO RTC-CHECK.
092200
092300*    IF SN OCCURS ON EARLIEST DATE THEN LUPA ADD ON APPLIES TO
092400*       SN
092500
092600     IF (H-HHA-REVENUE-EARLIEST-DATE (4) <
092700         H-HHA-REVENUE-EARLIEST-DATE (1)) AND
092800        (H-HHA-REVENUE-EARLIEST-DATE (4) <
092900         H-HHA-REVENUE-EARLIEST-DATE (3))
093000        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
093100           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
093200        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
093300           H-HHA-LUPA-ADD-ON-PAYMENT +
093400           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
093500           GO TO RTC-CHECK.
093600
093700*    IF PT  EARLIEST DATE = SLT EARLIEST AND = SN EARLIEST
093800*    THEN LUPA ADD ON APPLIES TO SN
093900*
094000
094100     IF (H-HHA-REVENUE-EARLIEST-DATE (1) =
094200         H-HHA-REVENUE-EARLIEST-DATE (3)) AND
094300        (H-HHA-REVENUE-EARLIEST-DATE (1) =
094400         H-HHA-REVENUE-EARLIEST-DATE (4))
094500        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
094600           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
094700        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
094800           H-HHA-LUPA-ADD-ON-PAYMENT +
094900           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
095000           GO TO RTC-CHECK.
095100
095200*    IF PT EARLIEST DATE = SN EARLIEST
095300*    THEN LUPA ADD ON APPLIES TO SN
095400*
095500
095600     IF (H-HHA-REVENUE-EARLIEST-DATE (1) =
095700         H-HHA-REVENUE-EARLIEST-DATE (4))
095800        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
095900           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
096000        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
096100           H-HHA-LUPA-ADD-ON-PAYMENT +
096200           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
096300           GO TO RTC-CHECK.
096400
096500*    IF SLT EARLIEST DATE = SN EARLIEST
096600*    THEN LUPA ADD ON APPLIES TO SN
096700*
096800
096900     IF (H-HHA-REVENUE-EARLIEST-DATE (3) =
097000         H-HHA-REVENUE-EARLIEST-DATE (4))
097100        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
097200           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
097300        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
097400           H-HHA-LUPA-ADD-ON-PAYMENT +
097500           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
097600           GO TO RTC-CHECK.
097700
097800*    IF PT  EARLIEST DATE = SLT EARLIEST
097900*    THEN LUPA ADD ON APPLIES TO PT
098000*
098100
098200     IF (H-HHA-REVENUE-EARLIEST-DATE (1) =
098300         H-HHA-REVENUE-EARLIEST-DATE (3))
098400        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) ROUNDED =
098500           H-HHA-REVENUE-DOLL-RATE (1) * LUPA-ADD-ON-PT1
098600        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
098700           H-HHA-LUPA-ADD-ON-PAYMENT +
098800           H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
098900           GO TO RTC-CHECK.
099000
099100
099200 RTC-CHECK.
099300************************************************************
099400* ZERO OUT LUPA ADD-ON PAYMENT WHEN CERTAIN CONDITIONS MET *
099500************************************************************
099600
099700     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
099800
099900     IF H-HHA-ADMIT-DATE NOT = H-HHA-SERV-FROM-DATE
100000         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
100100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
100200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
100300                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
100400                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
100500                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
100600*
100700     IF (WORK-HRG1 =  '1' OR '2')
100800       NEXT SENTENCE
100900     ELSE
101000         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
101100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
101200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
101300                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
101400                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
101500                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
101600*
101700     IF (H-HHA-LUPA-SRC-ADM = 'B' OR 'C')
101800         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
101900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
102000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
102100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
102200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
102300                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
102400*
102500
102600     IF H-HHA-RECODE-IND  = '2'
102700         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
102800                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
102900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
103000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
103100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
103200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
103300
103400*
103500     IF H-HHA-REVENUE-SUM1-6-QTY-ALL = 0
103600         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
103700                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
103800                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
103900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
104000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
104100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
104200*
104300        PERFORM 1050-LUPA THRU 1050-EXIT.
104400
104500        IF H-HHA-LUPA-ADD-ON-PAYMENT > 0
104600           MOVE '14' TO H-HHA-PAY-RTC
104700        ELSE
104800           MOVE '06' TO H-HHA-PAY-RTC
104900        END-IF.
105000
105100**   CHANGE DATES WITH DEFAULT BACK TO ZERO FOR PASSBACK       **
105200
105300     IF H-HHA-REVENUE-EARLIEST-DATE (1) = 29990101
105400        MOVE 0 TO H-HHA-REVENUE-EARLIEST-DATE (1).
105500
105600     IF H-HHA-REVENUE-EARLIEST-DATE (3) = 29990101
105700        MOVE 0 TO H-HHA-REVENUE-EARLIEST-DATE (3).
105800
105900     IF H-HHA-REVENUE-EARLIEST-DATE (4) = 29990101
106000        MOVE 0 TO H-HHA-REVENUE-EARLIEST-DATE (4).
106100
106200
106300        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =
106400                H-HHA-REVENUE-COST (1) +
106500                H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) +
106600                H-HHA-REVENUE-COST (2) +
106700                H-HHA-REVENUE-ADD-ON-VISIT-AMT (2) +
106800                H-HHA-REVENUE-COST (3) +
106900                H-HHA-REVENUE-ADD-ON-VISIT-AMT (3) +
107000                H-HHA-REVENUE-COST (4) +
107100                H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) +
107200                H-HHA-REVENUE-COST (5) +
107300                H-HHA-REVENUE-ADD-ON-VISIT-AMT (5) +
107400                H-HHA-REVENUE-COST (6) +
107500                H-HHA-REVENUE-ADD-ON-VISIT-AMT (6).
107600
107700        GO TO 1000-EXIT.
107800
107900 PEP-CHECK.
108000
108100     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')
108200         MOVE '20' TO H-HHA-PAY-RTC
108300         GO TO 1000-EXIT.
108400
108500      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT
108600         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.
108700
108800      IF WK-HRG-NO-OF-DAYS-TOT > 60
108900         MOVE '16' TO H-HHA-PAY-RTC
109000         GO TO 1000-EXIT.
109100
109200
109300*********  HRG  PAYMENT   *******************
109400
109500***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
109600        IF H-HHA-HRG-INPUT-CODE (2) = SPACES
109700           IF H-HHA-PEP-INDICATOR = 'N'
109800              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT
109900                  VARYING CO1 FROM 1 BY 1 UNTIL
110000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
110100                   CO1 > 6
110200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
110300               GO TO 1000-EXIT.
110400
110500
110600***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
110700        IF H-HHA-HRG-INPUT-CODE (2) = SPACES
110800           IF H-HHA-PEP-INDICATOR = 'Y'
110900              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT
111000                  VARYING CO1 FROM 1 BY 1 UNTIL
111100*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
111200                   CO1 > 6
111300               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
111400               GO TO 1000-EXIT.
111500
111600**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
111700        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES
111800           IF H-HHA-PEP-INDICATOR = 'N'
111900              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT
112000                  VARYING CO1 FROM 1 BY 1 UNTIL
112100*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
112200                   CO1 > 6
112300               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
112400               GO TO 1000-EXIT.
112500
112600**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
112700        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES
112800           IF H-HHA-PEP-INDICATOR = 'Y'
112900              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT
113000                  VARYING CO1 FROM 1 BY 1 UNTIL
113100*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
113200                   CO1 > 6
113300               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
113400               GO TO 1000-EXIT.
113500
113600
113700      MOVE '20' TO H-HHA-PAY-RTC.
113800
113900 1000-EXIT.  EXIT.
114000 1050-LUPA.
114100
114200***************************************************************
114300*                    LUPA PAYMENT
114400***************************************************************
114500
114600*    IF H-HHA-REVENUE-QTY-COV-VISITS (1) = 0
114700*       GO TO 1050-EXIT.
114800
114900     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
115000
115100     COMPUTE FED-ADJ1 ROUNDED =
115200            (H-HHA-REVENUE-QTY-COV-VISITS (1) *
115300             H-HHA-REVENUE-DOLL-RATE (1)).
115400
115500     COMPUTE FED-LUPA-ADJ1 ROUNDED =
115600             H-HHA-REVENUE-ADD-ON-VISIT-AMT (1).
115700
115800     COMPUTE FED-LABOR-ADJ1 ROUNDED =
115900             WIR-CBSA-WAGEIND *
116000             LABOR-PERCENT *
116100             FED-ADJ1.
116200
116300     COMPUTE FED-LABOR-LUPA-ADJ1 ROUNDED =
116400             WIR-CBSA-WAGEIND *
116500             LABOR-PERCENT *
116600             FED-LUPA-ADJ1.
116700
116800     COMPUTE FED-NON-LABOR-ADJ1 ROUNDED =
116900             NONLABOR-PERCENT *
117000             FED-ADJ1.
117100
117200     COMPUTE FED-NON-LABOR-LUPA-ADJ1 ROUNDED =
117300             NONLABOR-PERCENT *
117400             FED-LUPA-ADJ1.
117500
117600     COMPUTE H-HHA-REVENUE-COST (1) ROUNDED =
117700             (FED-LABOR-ADJ1 + FED-NON-LABOR-ADJ1).
117800
117900     COMPUTE H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) ROUNDED =
118000             (FED-LABOR-LUPA-ADJ1 + FED-NON-LABOR-LUPA-ADJ1).
118100
118200     COMPUTE FED-ADJ2 ROUNDED =
118300            (H-HHA-REVENUE-QTY-COV-VISITS (2) *
118400             H-HHA-REVENUE-DOLL-RATE (2)).
118500
118600     COMPUTE FED-LABOR-ADJ2 ROUNDED =
118700             WIR-CBSA-WAGEIND *
118800             LABOR-PERCENT *
118900             FED-ADJ2.
119000
119100     COMPUTE FED-NON-LABOR-ADJ2 ROUNDED =
119200             NONLABOR-PERCENT *
119300             FED-ADJ2.
119400
119500     COMPUTE H-HHA-REVENUE-COST (2) ROUNDED =
119600             (FED-LABOR-ADJ2 + FED-NON-LABOR-ADJ2).
119700
119800     COMPUTE FED-ADJ3 ROUNDED =
119900            (H-HHA-REVENUE-QTY-COV-VISITS (3) *
120000             H-HHA-REVENUE-DOLL-RATE (3)).
120100
120200     COMPUTE FED-LUPA-ADJ3 ROUNDED =
120300             H-HHA-REVENUE-ADD-ON-VISIT-AMT (3).
120400
120500     COMPUTE FED-LABOR-ADJ3 ROUNDED =
120600             WIR-CBSA-WAGEIND *
120700             LABOR-PERCENT *
120800             FED-ADJ3.
120900
121000     COMPUTE FED-LABOR-LUPA-ADJ3 ROUNDED =
121100             WIR-CBSA-WAGEIND *
121200             LABOR-PERCENT *
121300             FED-LUPA-ADJ3.
121400
121500     COMPUTE FED-NON-LABOR-ADJ3 ROUNDED =
121600             NONLABOR-PERCENT *
121700             FED-ADJ3.
121800
121900     COMPUTE FED-NON-LABOR-LUPA-ADJ3 ROUNDED =
122000             NONLABOR-PERCENT *
122100             FED-LUPA-ADJ3.
122200
122300     COMPUTE H-HHA-REVENUE-COST (3) ROUNDED =
122400             (FED-LABOR-ADJ3 + FED-NON-LABOR-ADJ3).
122500
122600     COMPUTE H-HHA-REVENUE-ADD-ON-VISIT-AMT (3) ROUNDED =
122700             (FED-LABOR-LUPA-ADJ3 + FED-NON-LABOR-LUPA-ADJ3).
122800
122900     COMPUTE FED-ADJ4 ROUNDED =
123000            (H-HHA-REVENUE-QTY-COV-VISITS (4) *
123100             H-HHA-REVENUE-DOLL-RATE (4)).
123200
123300     COMPUTE FED-LUPA-ADJ4 ROUNDED =
123400             H-HHA-REVENUE-ADD-ON-VISIT-AMT (4).
123500
123600     COMPUTE FED-LABOR-ADJ4 ROUNDED =
123700             WIR-CBSA-WAGEIND *
123800             LABOR-PERCENT *
123900             FED-ADJ4.
124000
124100     COMPUTE FED-LABOR-LUPA-ADJ4 ROUNDED =
124200             WIR-CBSA-WAGEIND *
124300             LABOR-PERCENT *
124400             FED-LUPA-ADJ4.
124500
124600     COMPUTE FED-NON-LABOR-ADJ4 ROUNDED =
124700             NONLABOR-PERCENT *
124800             FED-ADJ4.
124900
125000     COMPUTE FED-NON-LABOR-LUPA-ADJ4 ROUNDED =
125100             NONLABOR-PERCENT *
125200             FED-LUPA-ADJ4.
125300
125400     COMPUTE H-HHA-REVENUE-COST (4) ROUNDED =
125500             (FED-LABOR-ADJ4 + FED-NON-LABOR-ADJ4).
125600
125700     COMPUTE H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
125800             (FED-LABOR-LUPA-ADJ4 + FED-NON-LABOR-LUPA-ADJ4).
125900
126000     COMPUTE FED-ADJ5 ROUNDED =
126100            (H-HHA-REVENUE-QTY-COV-VISITS (5) *
126200             H-HHA-REVENUE-DOLL-RATE (5)).
126300
126400     COMPUTE FED-LABOR-ADJ5 ROUNDED =
126500             WIR-CBSA-WAGEIND *
126600             LABOR-PERCENT *
126700             FED-ADJ5.
126800
126900
127000     COMPUTE FED-NON-LABOR-ADJ5 ROUNDED =
127100             NONLABOR-PERCENT *
127200             FED-ADJ5.
127300
127400     COMPUTE H-HHA-REVENUE-COST (5) ROUNDED =
127500             (FED-LABOR-ADJ5 + FED-NON-LABOR-ADJ5).
127600
127700     COMPUTE FED-ADJ6 ROUNDED =
127800            (H-HHA-REVENUE-QTY-COV-VISITS (6) *
127900             H-HHA-REVENUE-DOLL-RATE (6)).
128000
128100     COMPUTE FED-LABOR-ADJ6 ROUNDED =
128200             WIR-CBSA-WAGEIND *
128300             LABOR-PERCENT *
128400             FED-ADJ6.
128500
128600
128700     COMPUTE FED-NON-LABOR-ADJ6 ROUNDED =
128800             NONLABOR-PERCENT *
128900             FED-ADJ6.
129000
129100     COMPUTE H-HHA-REVENUE-COST (6) ROUNDED =
129200             (FED-LABOR-ADJ6 + FED-NON-LABOR-ADJ6).
129300
129400
129500 1050-EXIT.   EXIT.
129600
129700 1100-ADD-HRG-DAYS.
129800
129900      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC
130000         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO
130100             WK-HRG-NO-OF-DAYS-TOT.
130200
130300 1100-EXIT.   EXIT.
130400
130500 3000-PEP-N-ADJUST.
130600
130700***************************************************************
130800*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT
130900***************************************************************
131000
131100     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
131200        MOVE 6 TO CO1
131300        GO TO 3000-EXIT.
131400
131500     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
131600
131700     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
131800
131900*         YEARCHANGE                              ===========**
132000
132100      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
132200
132300*         YEARCHANGE                              ===========**
132400
132500
132600*    IF HHA-SERV-THRU-DATE > 20071231 AND
132700*       HHA-SERV-FROM-DATE > 20071231
132800*        NEXT SENTENCE
132900*    ELSE
133000*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
133100
133200     COMPUTE FED-ADJ ROUNDED =
133300               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
133400
133500     COMPUTE FED-LABOR-ADJ ROUNDED =
133600              (WIR-CBSA-WAGEIND *
133700               LABOR-PERCENT * FED-ADJ).
133800
133900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
134000              (NONLABOR-PERCENT * FED-ADJ).
134100
134200     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =
134300          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
134400
134500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
134600             WK-3000-PEP-N-PAYMENT.
134700
134800     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =
134900             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.
135000
135100
135200 3000-EXIT.   EXIT.
135300
135400 4000-PEP-Y-ADJUST.
135500
135600***************************************************************
135700*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT
135800***************************************************************
135900
136000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
136100        MOVE 6 TO SUB1
136200        GO TO 4000-EXIT.
136300
136400     MOVE 2 TO WK-RTC-ADJ-IND.
136500
136600     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
136700
136800     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
136900
137000*         YEARCHANGE                              ===========**
137100
137200      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
137300
137400*         YEARCHANGE                              ===========**
137500
137600
137700*    IF HHA-SERV-THRU-DATE > 20071231 AND
137800*       HHA-SERV-FROM-DATE > 20071231
137900*        NEXT SENTENCE
138000*    ELSE
138100*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
138200
138300
138400     COMPUTE FED-ADJP ROUNDED =
138500               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
138600
138700     COMPUTE FED-LABOR-ADJP ROUNDED =
138800               WIR-CBSA-WAGEIND *
138900               LABOR-PERCENT * FED-ADJP.
139000
139100     COMPUTE FED-NON-LABOR-ADJP ROUNDED =
139200               NONLABOR-PERCENT * FED-ADJP.
139300
139400     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =
139500         (FED-LABOR-ADJP + FED-NON-LABOR-ADJP + FED-SUPPLY-ADJ).
139600
139700     COMPUTE WK-HRG-NO-OF-DAYS-FAC ROUNDED =
139800               (WK-HRG-NO-OF-DAYS / 60).
139900
140000     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =
140100             WK-4000-PEP-Y-PAYMENT *
140200             WK-HRG-NO-OF-DAYS-FAC.
140300
140400     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
140500             WK-4000-PEP-Y-PAYMENT.
140600
140700     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =
140800             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.
140900
141000
141100 4000-EXIT.   EXIT.
141200 5000-PEP-N-ADJUST.
141300
141400***************************************************************
141500*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT
141600***************************************************************
141700
141800     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
141900        MOVE 6 TO SUB1
142000        GO TO 5000-EXIT.
142100
142200     MOVE 1 TO WK-RTC-ADJ-IND.
142300
142400     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
142500
142600     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
142700
142800*         YEARCHANGE                              ===========**
142900
143000      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
143100
143200*         YEARCHANGE                              ===========**
143300
143400
143500*    IF HHA-SERV-THRU-DATE > 20071231 AND
143600*       HHA-SERV-FROM-DATE > 20071231
143700*        NEXT SENTENCE
143800*    ELSE
143900*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
144000
144100
144200     COMPUTE FED-ADJ ROUNDED =
144300               (WK-HRG-NO-OF-DAYS  *
144400                H-HHA-HRG-WGTS (CO1) *
144500                FED-EPISODE-RATE-AMT) / 60.
144600
144700     COMPUTE FED-LABOR-ADJ ROUNDED =
144800               WIR-CBSA-WAGEIND *
144900               LABOR-PERCENT * FED-ADJ.
145000
145100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
145200               NONLABOR-PERCENT * FED-ADJ.
145300
145400     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =
145500           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
145600
145700     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
145800             WK-5000-PEP-N-PAYMENT.
145900
146000
146100     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =
146200             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.
146300
146400
146500 5000-EXIT.   EXIT.
146600 6000-PEP-Y-ADJUST.
146700
146800***************************************************************
146900*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE
147000***************************************************************
147100
147200     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
147300        MOVE 6 TO SUB1
147400        GO TO 6000-EXIT.
147500
147600     MOVE 3 TO WK-RTC-ADJ-IND.
147700
147800     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
147900     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.
148000
148100     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
148200
148300*         YEARCHANGE                              ===========**
148400
148500      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
148600
148700*         YEARCHANGE                              ===========**
148800
148900
149000*    IF HHA-SERV-THRU-DATE > 20071231 AND
149100*       HHA-SERV-FROM-DATE > 20071231
149200*        NEXT SENTENCE
149300*    ELSE
149400*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
149500*
149600*    COMPUTE FED-ADJ ROUNDED =
149700*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)
149800*                                *
149900*                    ((WK-PEP-DAYS / 60)
150000*                                *
150100*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).
150200*
150300*
150400*    COMPUTE FED-ADJ ROUNDED =
150500*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)
150600*                                *
150700*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *
150800*                          FED-EPISODE-RATE-AMT) / 60).
150900
151000     COMPUTE FED-ADJ  ROUNDED =
151100      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *
151200                           FED-EPISODE-RATE-AMT) / 60).
151300
151400     COMPUTE FED-ADJ ROUNDED  =
151500                  (FED-ADJP * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.
151600
151700     COMPUTE FED-LABOR-ADJ ROUNDED =
151800               WIR-CBSA-WAGEIND *
151900               LABOR-PERCENT * FED-ADJ.
152000
152100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
152200               NONLABOR-PERCENT * FED-ADJ.
152300
152400     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =
152500          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
152600
152700     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
152800             WK-6000-PEP-Y-PAYMENT.
152900
153000     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =
153100             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.
153200
153300
153400 6000-EXIT.   EXIT.
153500
153600 7000-OUTLIER-PAYMENT.
153700***************************************************************
153800*                    OUTLIER PAYMENT
153900***************************************************************
154000     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =
154100               WIR-CBSA-WAGEIND *
154200               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.
154300
154400     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =
154500               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.
154600
154700     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =
154800             (OUT-THRES-LABOR-ADJ +
154900              OUT-THRES-NON-LABOR-ADJ).
155000
155100      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =
155200              OUT-THRES-AMT-ADJ +
155300             WK-3000-PEP-N-PRETOT-PAY +
155400             WK-4000-PEP-Y-PRETOT-PAY +
155500             WK-5000-PEP-N-PRETOT-PAY +
155600             WK-6000-PEP-Y-PRETOT-PAY.
155700
155800      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT
155900                  VARYING CO1 FROM 1 BY 1 UNTIL
156000                   CO1 > 6.
156100
156200      COMPUTE WK-7000-AB-DIFF ROUNDED =
156300              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.
156400****===================
156500      IF WK-7000-AB-DIFF > ZERO
156600         COMPUTE WK-7000-CALC ROUNDED =
156700               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF
156800
156900*** ================== NEW OUTLIER CAP HERE ========
157000         PERFORM 10000-OUTLIER-CAP-CALC THRU 10000-EXIT
157100*** ================== NEW OUTLIER CAP HERE ========
157200
157300****===================
157400         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =
157500               WK-7000-CALC
157600
157700****===================
157800         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
157900                (WK-7000-CALC +
158000                 WK-3000-PEP-N-PRETOT-PAY +
158100                 WK-4000-PEP-Y-PRETOT-PAY +
158200                 WK-5000-PEP-N-PRETOT-PAY +
158300                 WK-6000-PEP-Y-PRETOT-PAY)
158400
158500          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT
158600      ELSE
158700         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
158800                (WK-3000-PEP-N-PRETOT-PAY +
158900                 WK-4000-PEP-Y-PRETOT-PAY +
159000                 WK-5000-PEP-N-PRETOT-PAY +
159100                 WK-6000-PEP-Y-PRETOT-PAY)
159200          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.
159300
159400
159500 7000-EXIT.   EXIT.
159600
159700 8000-ADD-REV-DOLL.
159800
159900***************************************************************
160000*        ADD ALL REVENUE DOLLARS
160100***************************************************************
160200
160300     IF H-HHA-REVENUE-CODE (CO1) = SPACES
160400        MOVE 6 TO CO1
160500        GO TO 8000-EXIT.
160600
160700     IF H-HHA-REVENUE-QTY-COV-VISITS (CO1) = 0
160800        GO TO 8000-EXIT.
160900
161000     COMPUTE FED-ADJ ROUNDED =
161100                H-HHA-REVENUE-DOLL-RATE (CO1) *
161200                H-HHA-REVENUE-QTY-COV-VISITS (CO1).
161300
161400     COMPUTE FED-LABOR-ADJ ROUNDED =
161500               WIR-CBSA-WAGEIND *
161600               LABOR-PERCENT * FED-ADJ.
161700
161800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
161900               NONLABOR-PERCENT * FED-ADJ.
162000
162100     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =
162200           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).
162300
162400
162500     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =
162600               WK-8000-OUTLIER-LAB-NLAB.
162700
162800     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =
162900             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.
163000
163100 8000-EXIT.   EXIT.
163200
163300 9000-WHICH-RTC-OUTLIER.
163400
163500      MOVE '01' TO H-HHA-PAY-RTC.
163600      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.
163700      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.
163800      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.
163900      IF WK-RTC-ADJ-IND = 4  MOVE '02' TO H-HHA-PAY-RTC.
164000
164100
164200 9000-EXIT.   EXIT.
164300
164400 9050-WHICH-RTC-NO-OUTLIER.
164500
164600      MOVE '00' TO H-HHA-PAY-RTC.
164700
164800      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.
164900      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.
165000      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.
165100
165200 9050-EXIT.   EXIT.
165300
165400*         YEARCHANGE  2011.0                      ===========**
165500
165600 10000-OUTLIER-CAP-CALC.
165700
165800     IF  HHA-PROV-PAYMET-TOTAL = 0
165900        GO TO 10000-EXIT.
166000
166100     IF  HHA-PROV-OUTLIER-PAY-TOTAL = 0
166200        GO TO 10000-EXIT.
166300
166400     COMPUTE WK-10000-OUTLIER-POOL-PERCENT ROUNDED =
166500         HHA-PROV-PAYMET-TOTAL * .1.
166600
166700     COMPUTE WK-10000-OUTLIER-AVAIL-POOL ROUNDED =
166800      WK-10000-OUTLIER-POOL-PERCENT - HHA-PROV-OUTLIER-PAY-TOTAL.
166900
167000      COMPUTE WK-10000-OUTLIER-POOL-DIF ROUNDED =
167100         WK-10000-OUTLIER-AVAIL-POOL - WK-7000-CALC.
167200
167300      IF WK-10000-OUTLIER-POOL-DIF > 0
167400        GO TO 10000-EXIT.
167500
167600      IF WK-10000-OUTLIER-POOL-DIF < 0 OR
167700         HHA-PROV-OUTLIER-PAY-TOTAL < 0
167800        COMPUTE WK-7000-CALC ROUNDED = 0
167900        MOVE 4 TO WK-RTC-ADJ-IND.
168000
168100*         YEARCHANGE  2011.0                      ===========**
168200
168300 10000-EXIT.   EXIT.
168400
168500*         YEARCHANGE  2016.0                      ===========**
168600
168700 10100-SUPPLY-ADD-ON-CALC.
168800
168900*===========================================================**
169000*   RURAL, NO QUALITY DATA       = 10B COL 6           =====**
169100*   RURAL, WITH QUALITY DATA     = 10B COL 4           =====**
169200*   NON-RURAL, NO QUALITY DATA   =  7B COL 4           =====**
169300*   NON-RURAL, WITH QUALITY DATA =  6B COL 4           =====**
169400*===========================================================**
169500
169510*    YEARCHANGE  2016.0 NON RURAL W/ QUALITY DATA  ====**
169520*    YEARCHANGE  2016.0 TABLE  6B 4TH COL          ====**
169530
169600     IF HHA-CBSA-RURAL-CHECK
169700     OR HHA-CBSA-RURAL-CHECK-ALL
169800       GO TO RURAL-DATA-CHECK.
169900
170000     IF HHA-WITH-DATA-CHECK
170100       NEXT SENTENCE
170200     ELSE
170300       GO TO NO-DATA-CHECK.
170700
170800        IF  WORK-HRG5 = 'S' OR '1'
170900         MOVE 0000014.22 TO FED-SUPPLY-ADJ
171000         GO TO 10100-EXIT.
171100
171200        IF  WORK-HRG5 = 'T' OR '2'
171300         MOVE 0000051.35 TO FED-SUPPLY-ADJ
171400         GO TO 10100-EXIT.
171500
171600        IF  WORK-HRG5 = 'U' OR '3'
171700         MOVE 0000140.80 TO FED-SUPPLY-ADJ
171800         GO TO 10100-EXIT.
171900
172000        IF  WORK-HRG5 = 'V' OR '4'
172100         MOVE 0000209.18 TO FED-SUPPLY-ADJ
172200         GO TO 10100-EXIT.
172300
172400        IF  WORK-HRG5 = 'W' OR '5'
172500         MOVE 0000322.57 TO FED-SUPPLY-ADJ
172600         GO TO 10100-EXIT.
172700
172800        IF  WORK-HRG5 = 'X' OR '6'
172900         MOVE 0000554.79 TO FED-SUPPLY-ADJ
173000         GO TO 10100-EXIT.
173100
173200 NO-DATA-CHECK.
173300
173310*    YEARCHANGE  2016.0 NON RURAL WO/ QUALITY DATA   ====**
173320*    YEARCHANGE  2016.0 TABLE  7B 4TH COL            ====**
173330
173400     IF HHA-NO-DATA-CHECK
173500       NEXT SENTENCE
173600     ELSE
173700         GO TO 10100-EXIT.
174100
174200        IF  WORK-HRG5 = 'S' OR '1'
174300         MOVE 0000013.94 TO FED-SUPPLY-ADJ
174400         GO TO 10100-EXIT.
174500
174600        IF  WORK-HRG5 = 'T' OR '2'
174700         MOVE 0000050.35 TO FED-SUPPLY-ADJ
174800         GO TO 10100-EXIT.
174900
175000        IF  WORK-HRG5 = 'U' OR '3'
175100         MOVE 0000138.05 TO FED-SUPPLY-ADJ
175200         GO TO 10100-EXIT.
175300
175400        IF  WORK-HRG5 = 'V' OR '4'
175500         MOVE 0000205.10 TO FED-SUPPLY-ADJ
175600         GO TO 10100-EXIT.
175700
175800        IF  WORK-HRG5 = 'W' OR '5'
175900         MOVE 0000316.27 TO FED-SUPPLY-ADJ
176000         GO TO 10100-EXIT.
176100
176200        IF  WORK-HRG5 = 'X' OR '6'
176300         MOVE 0000543.95 TO FED-SUPPLY-ADJ
176400         GO TO 10100-EXIT.
176600
176700*===========================================================**
176800*   RURAL, NO QUALITY DATA       = 10B COL 6           =====**
176900*   RURAL, WITH QUALITY DATA     = 10B COL 4           =====**
177000*   NON-RURAL, NO QUALITY DATA   =  7B COL 4           =====**
177100*   NON-RURAL, WITH QUALITY DATA =  6B COL 4           =====**
177200*===========================================================**
177300 RURAL-DATA-CHECK.
177310
177320*    YEARCHANGE  2016.0 RURAL W/ QUALITY DATA      ====**
177330*    YEARCHANGE  2016.0 TABLE 10B  COL 4           ====**
177400
177500     IF HHA-WITH-DATA-CHECK
177600       NEXT SENTENCE
177700     ELSE
177800       GO TO RURAL-NO-DATA-CHECK.
178200
178300        IF  WORK-HRG5 = 'S' OR '1'
178400         MOVE 0000014.65 TO FED-SUPPLY-ADJ
178500         GO TO 10100-EXIT.
178600
178700        IF  WORK-HRG5 = 'T' OR '2'
178800         MOVE 0000052.89 TO FED-SUPPLY-ADJ
178900         GO TO 10100-EXIT.
179000
179100        IF  WORK-HRG5 = 'U' OR '3'
179200         MOVE 0000145.02 TO FED-SUPPLY-ADJ
179300         GO TO 10100-EXIT.
179400
179500        IF  WORK-HRG5 = 'V' OR '4'
179600         MOVE 0000215.46 TO FED-SUPPLY-ADJ
179700         GO TO 10100-EXIT.
179800
179900        IF  WORK-HRG5 = 'W' OR '5'
180000         MOVE 0000332.24 TO FED-SUPPLY-ADJ
180100         GO TO 10100-EXIT.
180200
180300        IF  WORK-HRG5 = 'X' OR '6'
180400         MOVE 0000571.42 TO FED-SUPPLY-ADJ.
180500         GO TO 10100-EXIT.
180600
180700 RURAL-NO-DATA-CHECK.
180710*    YEARCHANGE  2016.0 RURAL WO/ QUALITY DATA     ====**
180720*    YEARCHANGE  2016.0 TABLE 10B COL 6            ====**
180800
180900     IF HHA-NO-DATA-CHECK
181000       NEXT SENTENCE
181100     ELSE
181200         GO TO 10100-EXIT.
181700
181800        IF  WORK-HRG5 = 'S' OR '1'
181900         MOVE 0000014.36 TO FED-SUPPLY-ADJ
182000         GO TO 10100-EXIT.
182100
182200        IF  WORK-HRG5 = 'T' OR '2'
182300         MOVE 0000051.86 TO FED-SUPPLY-ADJ
182400         GO TO 10100-EXIT.
182500
182600        IF  WORK-HRG5 = 'U' OR '3'
182700         MOVE 0000142.19 TO FED-SUPPLY-ADJ
182800         GO TO 10100-EXIT.
182900
183000        IF  WORK-HRG5 = 'V' OR '4'
183100         MOVE 0000211.25 TO FED-SUPPLY-ADJ
183200         GO TO 10100-EXIT.
183300
183400        IF  WORK-HRG5 = 'W' OR '5'
183500         MOVE 0000325.76 TO FED-SUPPLY-ADJ
183600         GO TO 10100-EXIT.
183700
183800        IF  WORK-HRG5 = 'X' OR '6'
183900         MOVE 0000560.27 TO FED-SUPPLY-ADJ
184000         GO TO 10100-EXIT.
184400
184500 10100-EXIT.   EXIT.
184600
184700******        L A S T   S O U R C E   S T A T E M E N T   *****
